home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 013 / dlabelc1.arc / DLABELC.BAS (.txt) < prev   
Encoding:
GW-BASIC  |  1985-05-04  |  7.6 KB  |  230 lines
  1. 10  REM  ************************************************************
  2. 20  REM  ***  DISKETTE LABEL PRINTER - R. W. LENNOX (313)689-6139 ***
  3. 30  REM  ***  COMMENT LINES OPTIONAL FOR 4" LABELS -jw 12/29/84   ***
  4. 40  REM  ***  USES 1 1/2 x 4 INCH  1-UP LABEL STOCK (LABELSMC)    ***
  5. 50  REM  ***  MODIFIED FOR THE IBM GRAPHICS PRINTER 04/19/85      ***
  6. 55  REM  ***  BY A.R. TOWERS                                      ***
  7. 60  REM  ***  REQUIRES 80 COLUMN COLOR MONITOR.                   ***
  8. 70  REM  ***  WRITTEN FOR DOS 2.0 - BUT NO DIFFERENCES ARE        ***
  9. 80  REM  ***  ANTICIPATED RUNNING UNDER DOS 2.1                   ***
  10. 90  REM  ***  REQUIRED FILE - DIRECTRY.COM FROM "SOFTTALK" 01/84  ***
  11. 100  REM ***  IS ENCLUDED IN THIS PACKAGE.                        ***
  12. 110  REM ************************************************************
  13. 120  SCREEN 0:KEY OFF:DEF SEG
  14. 125  COLOR 13,1,1:
  15. 130  SUBRT$=STRING$(159,32)
  16. 140  SUBLC%=VARPTR(SUBRT$)
  17. 150  GOSUB 2270
  18. 160  BLOAD "DIRECTRY.COM",DIRECT
  19. 170  FCB$=STRING$(33,32)
  20. 180  DTA$=STRING$(33,32)
  21. 190  DIM PROG$(64)
  22. 200  DIM PROGEXT$(64)
  23. 210  DIM CPROG$(64)
  24. 220  DIM PROGSEL(64)
  25. 230  DIM DIRLST$(512)
  26. 240  FILLER$=STRING$(12,32)
  27. 250  COMA$=""
  28. 260  COMB$="                Southern Microcomputer Company"
  29. 270  COMC$="                Miami                    Tampa"
  30. 280  NDATE$=LEFT$(DATE$,6)+RIGHT$(DATE$,2)
  31. 290  FOR LOOP%=0 TO 512:DIRLST$(LOOP%)=FILLER$:NEXT
  32. 300  LPRINT CHR$(27);"G";         'SET DOUBLE STRIKE
  33. 310  LPRINT CHR$(27);"A";CHR$(9);CHR$(27);CHR$(50);
  34. 320  LPRINT CHR$(27);"E";         'SET EMPHASIZED
  35. 330  'LPRINT CHR$(27);"Q";CHR$(85); 'SET WIDTH
  36. 340  N=0:COUNT%=0
  37. 350  FOR X=1 TO 64:PROGSEL(X)=0:NEXT X
  38. 360  CLS
  39. 370  COLOR 14,1,1
  40. 380  LOCATE 1,15:PRINT "                                          "
  41. 390  LOCATE 2,15:PRINT "         DISKETTE LABEL PRINT             "
  42. 400  LOCATE 3,15:PRINT "                                          "
  43. 410  '
  44. 420  LOCATE 5,15:PRINT "THIS PROGRAM ALLOWS PRODUCTION OF DISKETTE"
  45. 430  LOCATE 6,15:PRINT "LABELS  USING  DIRECTORY  DATA AND A  USER"
  46. 440  LOCATE 7,15:PRINT "SUPPLIED TITLE.   INCLUSION  OF  DIRECTORY"
  47. 450  LOCATE 8,15:PRINT "ENTRIES (ALL/NONE/SELECTED) IS  CONTROLLED"
  48. 460  LOCATE 9,15:PRINT "BY THE OPERATOR.                          "
  49. 470  LOCATE 12,18:PRINT "ENTER 'X' FOR SYSTEM - ESCape TO END"
  50. 480  '
  51. 490  LOCATE 15,19:PRINT "                                  "
  52. 500  LOCATE 15,19:PRINT "ENTER TARGET DISK (ie. A,B,C,D): ";
  53. 510  GOSUB 2210:DSK$=KY$
  54. 520  HIT%=INSTR("ABCDX",DSK$)
  55. 530  IF HIT%=0 THEN GOTO 560 ELSE PRINT DSK$
  56. 540  IF DSK$="X" THEN 2180
  57. 550  GOTO 580
  58. 560  LOCATE 18,22:PRINT "INCORRECT TARGET DISK ENTERED"
  59. 570  BEEP:GOTO 480
  60. 580  LOCATE 18,22:PRINT "ENTER 'Y' TO READ DIRECTORY:     ";
  61. 590  GOSUB 2210:DTY$=KY$:PRINT DTY$
  62. 600  CLS
  63. 610  WIDTH 80
  64. 620  IF DTY$="Y" THEN 630 ELSE 750
  65. 630  LOCATE ,,0:GOSUB 2270
  66. 640  REM GET DIRECTORY AND SORT
  67. 650  CALL DIRECT(DSK$,FCB$,DTA$,DIRLST$(0),COUNT%)
  68. 660  F=1:I=0:LOCATE 10,20:PRINT "SORTING......PLEASE WAIT"
  69. 670  IF DIRLST$(I)>DIRLST$(I+1) THEN SWAP DIRLST$(I),DIRLST$(I+1):F=0
  70. 680  I=I+1:IF I<COUNT%-1 THEN 670
  71. 690  IF F= 0 THEN 660
  72. 700  CLS
  73. 710  LOCATE 2,10:PRINT "DIRECTORY ON DRIVE "DSK$": CONTAINS "COUNT%" ENTRIES"
  74. 720  IF COUNT%>55 THEN COUNT%=50:PRINT "ONLY 50 ENTRIES ALLOWED"
  75. 730  PRINT
  76. 740  FOR LOOP=0 TO COUNT%-1:PRINT DIRLST$(LOOP)SPC(6);:NEXT:PRINT
  77. 750  '
  78. 760  LOCATE 17,5:PRINT "                                                            "
  79. 770  LOCATE 17,5:INPUT "ENTER DISKETTE LABEL TITLE:",TITLE$
  80. 780  '
  81. 790  IF LEN(TITLE$) < 34 THEN 820
  82. 800  BEEP:LOCATE 21,10:PRINT "MAXUMUM OF 33 CHARACTERS ALLOWED"
  83. 810  GOTO 750
  84. 820  LOCATE 21,10:PRINT "                        "
  85. 830  '
  86. 840  LOCATE 18,5:PRINT "                               "
  87. 850  LOCATE 18,43:PRINT"001"
  88. 860  LOCATE 18,5:INPUT "ENTER DISKETTE VERSION NUMBER (000)   ",DSER$
  89. 870  IF DSER$="" THEN DSER$="001"
  90. 880  LOCATE 19,5:PRINT "                                            "
  91. 890  LOCATE 19,43:PRINT"DOS 2.1"
  92. 900  LOCATE 19,5:INPUT "ENTER OPERATING SYSTEM (ie. DOS 2.1)  ",OPER$
  93. 910  IF OPER$="" THEN OPER$="DOS 2.1"
  94. 920  LOCATE 20,5:PRINT "                                          "
  95. 930  LOCATE 20,43:PRINT"DSDD"
  96. 940  LOCATE 20,5:INPUT "ENTER DISKETTE TYPE (ie. DSDD, SSSD)  ",DTYPE$
  97. 950  IF DTYPE$="" THEN DTYPE$="DSDD"
  98. 960  LOCATE 21,5:PRINT "                                           "
  99. 970  LOCATE 21,43:PRINT"9-SEC"
  100. 980  LOCATE 21,5:INPUT "ENTER NUMBER OF SECTORS (ie. 9-SEC)   ",STYPE$
  101. 990  IF STYPE$="" THEN STYPE$="9-SEC"
  102. 1000  LOCATE 22,5:PRINT "                                              "
  103. 1010  LOCATE 22,43:PRINT NDATE$
  104. 1020  LOCATE 22,5:INPUT "ENTER FORMAT DATE (8 CHAR - ANY FORM) ",FDATE$
  105. 1030  IF FDATE$="" THEN FDATE$=NDATE$ ELSE NDATE$=FDATE$
  106. 1040  LOCATE 23,5:PRINT "                                                "
  107. 1050  LOCATE 23,43:PRINT"IBM"
  108. 1060  LOCATE 23,5:INPUT "ENTER DISKETTE MANUFACTURER           ",MTYPE$
  109. 1070  IF MTYPE$="" THEN MTYPE$="IBM"
  110. 1080  LNE=2:CLS
  111. 1090  LOCATE 1,2:PRINT "THE FOLLOWING PROGRAMS / FILES ARE ON THIS DISK:"
  112. 1100  GOSUB 1280 'COMPRESS NAMES
  113. 1110  FOR LOOP=0 TO COUNT%-1 STEP 4
  114. 1120  LNE=LNE+1:PST=2
  115. 1130  FOR LOOP1=LOOP TO LOOP+3
  116. 1140  IF DIRLST$(LOOP1)=FILLER$ THEN 1170
  117. 1150  LOCATE LNE,PST:PRINT LOOP1+1:LOCATE LNE,PST+3:PRINT"-"
  118. 1160  LOCATE LNE,PST+4:PRINT DIRLST$(LOOP1)
  119. 1170  PST=PST+19
  120. 1180  NEXT LOOP1
  121. 1190  NEXT LOOP
  122. 1200  '
  123. 1210  LOCATE 20,1:PRINT "ENTER NUMBER OF FILE NAME TO BE PRINTED ON LABEL"
  124. 1220  LOCATE 21,1:PRINT "SELECTED ENTRIES WILL BE HIGHLIGHTED ON THE SCREEN"
  125. 1230  LOCATE 22,1:INPUT "ENTER A ZERO WHEN DONE / 99 TO SELECT ALL FILES";P
  126. 1240  LOCATE 22,50:PRINT "   "
  127. 1250  IF P=99 THEN 1270
  128. 1260  IF P>COUNT% THEN BEEP:GOTO 1230
  129. 1270  GOTO 1390
  130. 1280  REM COMPRESS PROGRAM NAME AND EXTENSION
  131. 1290  FOR X%=0 TO COUNT%-1
  132. 1300  DIRENT$=""
  133. 1310  FOR Y%=1 TO 12
  134. 1320  CH$=MID$(DIRLST$(X%),Y%,1)
  135. 1330  IF CH$=" " THEN 1350
  136. 1340  DIRENT$=DIRENT$+CH$
  137. 1350  NEXT Y%
  138. 1360  DIRLST$(X%)=DIRENT$
  139. 1370  NEXT X%
  140. 1380  RETURN
  141. 1390  IF P=0 THEN 1620
  142. 1400  IF P<>99 THEN 1450
  143. 1410  FOR N=0 TO COUNT%-1
  144. 1420  PROGSEL(N)=1
  145. 1430  NEXT N
  146. 1440  GOTO 1620
  147. 1450  IF P<1 OR P>64 THEN LOCATE 23,50:PRINT"NOT ACCEPTED":BEEP:GOTO 1230
  148. 1460  LOCATE 23,50:PRINT"            "
  149. 1470  N=N+1
  150. 1480  PROGSEL(P-1)=1
  151. 1490  IF N>55 THEN 1620
  152. 1500  LNE=INT((P/4)+0.99)+2
  153. 1510  LNX=LNE-2
  154. 1520  BYT=P-((LNX-1)*4)
  155. 1530  IF BYT=1 THEN BYT=2:GOTO 1570
  156. 1540  IF BYT=2 THEN BYT=21
  157. 1550  IF BYT=3 THEN BYT=40
  158. 1560  IF BYT=4 THEN BYT=59
  159. 1570  LOCATE LNE,BYT
  160. 1590  PRINT P:LOCATE LNE,BYT+3:PRINT"-":LOCATE LNE,BYT+4:PRINT DIRLST$(P-1)
  161. 1600  '
  162. 1610  GOTO 1200
  163. 1620  REM SET UP LABEL
  164. 1630  LOCATE 23,50:PRINT"WORKING     "
  165. 1640  CLS
  166. 1650  '
  167. 1660  GOTO 1760
  168. 1670  LOCATE 5,5:PRINT "YOU MAY ENTER THREE LINES OF COMMENTS - 70 CHAR. EACH"
  169. 1680  LOCATE 6,5:PRINT "LINE 3 MAY BE PRE-DEFINED. IF SO IT WILL BE BYPASSED."
  170. 1690  LOCATE 9,5:PRINT "[                                                                      ]"
  171. 1700  LOCATE 10,5:PRINT "[                                                                      ]"
  172. 1710  LOCATE 11,5:PRINT "[                                                                      ]"
  173. 1720  IF COMC$="" THEN 1730 ELSE LOCATE 11,6:PRINT COMC$
  174. 1730  LOCATE 9,6:INPUT "",COMA$
  175. 1740  LOCATE 10,6:INPUT "",COMB$
  176. 1750  IF COMC$="" THEN LOCATE 11,6:INPUT "",COMC$
  177. 1760  LOCATE 10,20:INPUT "HOW MANY COPIES OF LABEL DO YOU WANT ";NC$:NC=VAL(NC$):IF NC<1 THEN 1760
  178. 1770  IF N>35 THEN JW= 11 ELSE JW= 7
  179. 1780  FOR LL= 1 TO NC
  180. 1790  LOCATE 10,20:PRINT "                                              "
  181. 1800  IF INKEY$=CHR$(27) THEN 2160
  182. 1810  LOCATE 10,20:PRINT "     PRINTING LABEL ";LL;" OF ";NC
  183. 1820  LPRINT TAB(1) TITLE$;
  184. 1830  LPRINT TAB(36) "#";DSER$
  185. 1840  LPRINT TAB(1) MTYPE$;
  186. 1850  LPRINT TAB(11) OPER$;"  ";DTYPE$;" ";STYPE$;"  ";FDATE$
  187. 1860  LPRINT "---------------------------------------"
  188. 1870  LPRINT CHR$(27);"F";         'SET EMPHASIZED OFF
  189. 1880  LPRINT CHR$(15);
  190. 1890  LPRINT CHR$(27);"A";CHR$(6);CHR$(27);CHR$(50);
  191. 1900  LPRINT CHR$(27);"S";CHR$(48);
  192. 1910  LNO=0:COL=0
  193. 1920  FOR X=0 TO 54
  194. 1930  IF PROGSEL(X)=0 THEN 2020
  195. 1940  COL=COL+1:IF X=0 THEN COL=1
  196. 1950  IF COL=1 THEN LPRINT TAB(3) DIRLST$(X);
  197. 1960  IF COL=2 THEN LPRINT TAB(16) DIRLST$(X);
  198. 1970  IF COL=3 THEN LPRINT TAB(29) DIRLST$(X);
  199. 1980  IF COL=4 THEN LPRINT TAB(42) DIRLST$(X);
  200. 1990  IF COL=5 THEN LPRINT TAB(55) DIRLST$(X):COL=0:LNO=LNO+1
  201. 2000  ' IF COL=6 THEN LPRINT TAB(68) DIRLST$(X):COL=0:LNO=LNO+1
  202. 2010  IF LNO=JW THEN 2030
  203. 2020  NEXT X
  204. 2030  IF COL>0 THEN LPRINT:LNO=LNO+1
  205. 2040  FOR X=1 TO (JW-LNO):LPRINT:NEXT X
  206. 2050  IF JW=11 THEN 2120 'SKIP DOTTED LINE AND COMMENTS IF MORE THAN 35 ENTRIES
  207. 2060  LPRINT "------------------------------------------------------------------"
  208. 2070  GOTO 2090
  209. 2080  LPRINT TAB(3) COMA$
  210. 2090  LPRINT TAB(3) COMB$
  211. 2100  LPRINT TAB(3) COMC$
  212. 2110  LPRINT
  213. 2120  LPRINT CHR$(27);"T";         'SET SUPERSCRIPT OFF
  214. 2130  LPRINT CHR$(27);"E";         'SET EMPHASIZED
  215. 2140  LPRINT CHR$(27);"A";CHR$(9);CHR$(27);CHR$(50);
  216. 2150  NEXT LL
  217. 2160  CLS:LOCATE 10,20:PRINT"REPRINT THIS LABEL? (`Y' TO REPRINT)"
  218. 2170  GOSUB 2210:IF KY$="Y" THEN 1760 ELSE LOCATE 10,20:PRINT "    WAIT.........RELOADING          ":GOTO 290
  219. 2180  CLS
  220. 2190  SYSTEM
  221. 2200  END
  222. 2210  REM GET IN KEY AND OR
  223. 2220  KY$=INKEY$:IF KY$="" THEN 2220
  224. 2230  IF KY$=CHR$(27) THEN COLOR 13,1,1:END
  225. 2240  IF KY$<CHR$(97) OR KY$>CHR$(122) THEN 2260
  226. 2250  KY$=CHR$(ASC(KY$)-32)
  227. 2260  RETURN
  228. 2270  DIRECT=PEEK(SUBLC%+1)+PEEK(SUBLC%+2)*256
  229. 2280  RETURN
  230.